COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00024 ENDMK
C⊗;

C*** 33 PARAMS SEEMS TO BE LIMIT IN THIS VERSION. (30 IN 'SCORE') *****
      DIMENSION RX(100),JX(100),W(35),IINS(135)
C  W(35) FOR PARAMETERS
      COMMON /TR/I(80),IX(50),NN(2),LX(12),INST(27,5),MX5(40)
     1,INSNUM(27),FQDR(5/32,27),P(30),NPAR(27),JSEM,IPRNT,IPP
     1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
     1,ENDX,J  /KNAM/KNAM,IPLAY
      COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT,JWRT
      INTEGER FQDR
      DOUBLE PRECISION IX
      EQUIVALENCE (IBL,LX(1)),(IZR,RZR)
     1 ,(LESS,LX(9)),(RX,IX,IXJ,JX),(INN,RNN),(RX2,RX(3)),
     1(P2,P(2)),(RX3,RX(5)),(I3,I(3)),(ISEMI,LX(2))
     1,(IBLA,LX(1)),(IAST,LX(3)),(IINS,INST)
     1,(IAROW,LX(7))
      DATA LX/' ',';', '*','/','-','+'
     1,"575004020100,'=','<' ,',' ,'(', ')'/,  IFIRST/-1/ 
     1 , IDOT/'.'/, IDEV/1/,JPRNT/-1/,JWRT/-1/
CC   1,ISCL/'CF','C','CS','DF','D','DS','EF','E','ES','FF','F','FS',
CC   1 'GF','G','GS','AF','A','AS','BF','B','BS'/,MX/0/
CCC  1, IDUR/'DUR'/,FILNM/"556563514300/,JPRNT/-1/,JWRT/-1/
C*** THIS VERSION STARTS OUT WITH DEFAULT OUTPUT TO FILE: FOR21.DAT
      DATA RMAG/.0512/,INUM/0/,SRATE/12800./,RNCHN/1./
     1,IALT/"765004020100/
CC   1,IWD/'PLAY','FINI','SRATE','NCHNS','PRINT',
CC   1 'CHA','POWER','SRT','GEN'/
C  LX INCLUDES ALL THE DIVIDERS.
555      LLLL=0
401      IF(IFIRST)404,  5,600
404      IGEN=-1
	IF(INUM.NE.0)GO TO 30
	DO 411 K=1,135
411	IINS(K)=0
C ZERO OUT INSTR. NAME ARRAY.
30    IPLAY=0
      ENDX=0
      JSEM=0
      INS=-1
402      IDEV=1
      TYPE 1
1	 FORMAT(' INPUT? '$)
100      FORMAT(' >'$)
2      FORMAT(A4)
      ACCEPT 2,IDBL
C IDBL WILL HAVE TO BE DOUBLE PREC. ON PDP11 ************
      IF(IDBL.NE.IBLA)GO TO 400
      IDEV=5
      GO TO 5
400      IF(IDBL.EQ.'&')GO TO 603    
C!*** & IS PRNT-NOPRNT FLIPFLOP
      IF(IDBL.EQ.'%')GO TO 604    
C!*** % IS WRT-NOWRT FLIPFLOP
CXX   REREAD 4,I                 
C! %  WRITES BINARY FILE.
410      CALL IFILE(1,IDBL)
	CALL OFILE(22,'D')
CC410      OPEN(UNIT=1,FILE=NM)
4      FORMAT(80A1)
5      IF(JSEM.AND.J.LT.MM)GO TO 305
      IF(JSEM.NE.99)GO TO 502
      IFIRST=IFIRST+10
      GO TO 555
CC      RETURN
600      JSEM=0
      IFIRST=IFIRST-10
      INS=-1
502      IF(IDEV.NE.5)GO TO 601
      IF(IGEN.NE.2)IGEN=-1
      TYPE 100
601      READ(IDEV,4,END=404)I
      IF(I(1).EQ.'!')GO TO 404  
C!**** USE ! TO RETURN TO 'INPUT?'
      IF(I(1).EQ.'%')GO TO 604   
C!*** %=WRITES BINARY FILE FOR21.DAT
      IF(I(1).NE.'&')GO TO 602   
C!*** &=TYPE OUT MUS5 NUMBERS
603      JPRNT=-JPRNT
      GO TO 401
604      JWRT=-JWRT            
C!*** DEFAULT IS NO-WRITE BINARY
      GO TO 401
602      IF(I(1).NE.IALT)GO TO 408
CCC      IF(I(2).NE.'I')GO TO 605   
C!***<ALT>I(NSTRUMENT LIST;)
      DO 606 K=1,INUM
      JK=NPAR(K)-2
606      TYPE 607,(INST(K,L),L=1,5),INSNUM(K),JK
      GO TO 5
607      FORMAT(1X,5A1,'  NUM=',I2,'  PARAMS=',I2)      
C!*** PRINTS INST INFO.
CCC605      SBFILN=FILNM
CCCCC      CALL PLAY  
C!**** GO PLAY SOMETHING
CCC   GO TO 5
408      DO 407 K=1,60
407      JX(K)=IBLA
      DO 405 K=1,80
      IF(I(K).EQ.LESS)GO TO 5
405      IF(I(K).NE.IBLA)GO TO 406
      GO TO 5
406      MM=0
        J=-1      
      IPRNT=0
      JI=0
9      M=0
      N=JI+1
6      JI=JI+1
      K=I(JI)
      DO 7 L=1,12
7      IF(K.EQ.LX(L))GO TO 8
      M=M+1
      GO TO 6            
C!**** NO STRING CAN EXCEED 10 CHARS.
8      IF(K.EQ.LESS)GO TO 15
      IF(M.EQ.0)GO TO 140
      IF(M.GT.10)M=10
      MM=MM+1
      IF(MM.LE.50)GO TO 88
      TYPE 888,(I(JJ),JJ=N,N+9)
      STOP
888      FORMAT(' LINE TOO LONG -- ',10A1)
88      JJ=I(N)
      IF(JJ)GO TO 16  
C!***** JUMP IF 1ST CHAR. IS A LETTER.
      Y=0
      DOT=10.
      DO 18 JK=N,N+M-1
      JA=I(JK)
      IF(JA.NE.IDOT)GO TO 17
      DOT=.1
      GO TO 18
17    X=NASCI(JA)                 
C!**** CHANGE ASCII INTO NUMBER
      IF(DOT.LT.1)GO TO 19
      Y=Y*DOT+X
      GO TO 18
19      Y=Y+X*DOT
      DOT=DOT/10.
18      CONTINUE
      RX(MM*2-1)=Y
      RX(MM*2)=-9999.0
      GO TO 140
16161	FORMAT(1X,I,3X10A1)

16	RX(MM*2-1)=0
        CALL MPACK(M,I(N),IX(MM),N)
C N=CURRENT POINTER TO I ARRAY - USED LATER TO LOCATE INST. NAMES.
26262	TYPE 16161,IX(MM),(I(KHH),KHH=N,N+M-1)
	IJ=JX(MM*2-1)
	IF(IJ.GE.0)GO TO 244
	JX(MM*2)=M
C SAVE THE WD CNT OF POTENTIAL INST. NAME.
	GO TO 10
244   IF(IJ.NE.412)GO TO 140
CCC   IF(IXJ.NE.'INSTR')GO TO 14
      INS=0
      GO TO 5
144      MX=MX+1
      MX5(MX)=IXJ      
C!*** PUT IS NEW UNIT GEN. NAME
      MX=MX+1
      MX5(MX)=RX(3)
      GO TO 5
140      IF(IJ.NE.413)GO TO 143
CCC140      IF(IXJ.NE.'UNIT')GO TO 143
      INS=1            
C!*** 'UNIT GENERATOR' IS RESERVED FOR NEW ONES.
      GO TO 5
143      IF(K.EQ.IBL)GO TO 10
      IF(L.EQ.8)K=IAROW      
C!::: CHANGE = INTO ←
      MM=MM+1
      JX(MM*2-1)= K
10      IF(I(JI+1).NE.IBL)GO TO 11
      JI=JI+1
      GO TO 10
11      IF(JI.LT.80)GO TO 9
C NOW WE HAVE ALL ITEMS IN IX ARRAY
15      MM=MM*2
      IF(IJ.NE.404)GO TO 142
CCC   IF(IXJ.NE.KPRNT)GO TO 142
      INS=-1    
C!***** FOR 'PRINT'
      IPRNT=-1
      
142      J=-1      
      IF(INS.LT.0)GO TO 305
      IF(INS.EQ.2)GO TO 305
26      IF(IJ.NE.12)GO TO 127
CCC26      IF(IXJ.NE.'END')GO TO 127
      MM=0
      INS=-1    
C!***** NOW INITITIALIZATION COMPLETE
      GO TO 5
127      IF(INS.EQ.1)GO TO 144      
C!*** FOR 'UNIT GEN' ADDED
CXCX  ASSUMES INST NAME STARTS IN COL.1 	L=N-1
	L=0
	M=JX(2)
      IF(INUM.EQ.0)GO TO 2127
      DO 1127 KL=1,INUM  
C!** FOR POSSIBLE REDEFINITION OF INST.
CC1127      IF(IXJ.EQ.INST(KL))GO TO 3127  
	DO 21 LQ=1,M
21	IF(INST(KL,LQ).NE.I(L+LQ))GO TO 1127
C TRY TO MATCH UP LETTERS WITH EXISTING INST. NAMES.
	GO TO 3127
C!*** IS INST ALREADY IN LIST?
C JUMP OUT IF MATCH WAS FOUND
1127	CONTINUE
2127      INUM=INUM+1
      K=INUM
CC3127      INST(K)=IXJ      
	DO 20 LQ=1,M
20	INST(K,LQ)=I(L+LQ)
C!**** GET THE NAME OF AN INST.(5 LTRS ONLY)
3127  INSNUM(K)=RX2   
C!*** GET ITS NUMBER.
      NPAR(K)=RX3+2   
C!**** GET NUM OF PARAMS, ADD 3 FOR W ARRAY
      K=7      
28      LL=-1
      IF(JX(K).NE.410)GO TO 31
CCC   IF(JX(K).NE.IDUR)GO TO 31
C  IF IT'S NOT 'DUR' THEN IT MUST BE 'FREQ'
      LL=-LL    
C!*** NOW LOOK AT REST OF THE LINE
31      K=K+2      
      IF(K.GT.MM)GO TO 5    
C!**** CHECK FOR END OF LINE
      IF(RX(K+1).NE.-9999.0)GO TO 28
      JA=RX(K)+2
      IF(JA.LT.5)GO TO 31     
C!***** IGNORE P1,P2 OF INPUT
      FQDR(JA,INUM)=LL   
C!**** 1=DUR, -1=FREQ, 0=ORDINARY NUM.
      GO TO 31
50      IF(IGEN)308,309,309
309      LL=LL-1
      IF(JSEM.LE.0.AND.IGEN.EQ.1)IGEN=-1   
C!*** FOUND 'END'
      GO TO 59
308      W(1)=1
      IF(LL-1.GE.NPAR(IK))GO TO 56
54      IF(LL.LT.3)LL=3
      DO 55 K=LL,NPAR(IK)-1
55      W(K)=P(K-2)    
C!***** GET INFO ALREADY IN PARAMS
56      DO 57 K=3,LL-1
57      P(K-2)=W(K)      
C!**** FILL UP P LIST AGAIN
      X=W(3)            
C!*** EXCHANGE W(2) AND W(3), ACTION TIME, INST #
      W(3)=W(2)
      W(2)=X
58      LL=NPAR(IK)
      DO 52 K=5,LL-1
      X=FQDR(K,IK)
      IF(X.EQ.0)GO TO 52
      IF(X)GO TO 53
      W(K)=RMAG/W(K)
      GO TO 52
53      W(K)=RMAG*W(K)
52      CONTINUE
      IF(ENDX.LT.W(2)+P2)ENDX=W(2)+P2
      W(LL)=RMAG/W(4)            
C!********* PUT MAG/P2 AT END
59       IF(JPRNT.GE.0)GO TO 591
      TYPE 590,KNAM
      KNAM=IBLA
      TYPE 51,LL,(W(K),K=1,LL)
      WRITE(22,51)LL,(W(K),K=1,LL)
C ABOVE WRITES ONTO FILE 'D.DAT' *** TEMPORARY FOR DEBUGGING.
591      IF(JWRT)WRITE(21)LL,(W(K),K=1,LL)
500      IFIRST=0
      IF(IGEN.EQ.0)IGEN=-1
      GO TO 555
CC      RETURN
590      FORMAT(I6)
CCC590      FORMAT(1XA5,1X$)

306      IF(JPRNT)TYPE 1307,(W(K),K=1,LL-1)
      IF(JPRNT.GT.0)TYPE 307,(W(K),K=1,LL-1)
      IPRNT=0                  
C!** RESET NO-PRNT FLAG
      JSEM=0                  
C!** RESET SEMICOLON FLAG
      INS=-1
      IF(J.GE.MM-1)GO TO 5      
C!** GO READ ANOTHER LINE
305      CALL MSCAN(LL,W)
303      IF(IPRNT)GO TO 306
      IF(J.LT.MM)JSEM=-1      
C!**** STILL MORE CHARS TO COME.
      IF(ENDX.GE.0)GO TO 302
      ENDX=0
      GO TO 500
302      IF(JSEM)50,5,5  
51      FORMAT(I3,35F10.3)
307      FORMAT(F11.4,$)
1307      FORMAT(F11.4)
      END

	FUNCTION NASCI(N)
       DATA  IEX/536870912/
C THIS BIG NUMBER MUST BE CHANGED ON PDP11***************
	NASCI=(N-'0')/IEX
C CONVERTS SINGLE ASCII CHARACTER TO INTEGER.
	END